home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
MACRO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-20
|
9KB
|
318 lines
UNIT Macro;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Keyboard mscros Last changed: 20.04.96 SA ║}
{║ ║}
{║ (C) Copyright 1989-94 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32;
PROCEDURE WriteMacroStatus;
PROCEDURE MacroMenu(VAR Key: LongInt);
IMPLEMENTATION
USES Dos, OpMacro, OpString, OpCrt, OpCmd, OpWindow, OpMacEd,
Util, StrUtil, OproUtil, Input, LogFile, KeyBoard, Globals,
MTask, PoPTypes;
PROCEDURE WriteMacroStatus;
VAR
ch : Char;
BEGIN
IF NOT InLogWin THEN ch:='─' ELSE ch:='═';
IF NOT KeyboardLock THEN
BEGIN
IF MacroRecording THEN
StatusStr:='*** REC *'
ELSE
IF MacrosAreOn THEN
StatusStr:='* MACRO *'
ELSE
StatusStr:='*********';
END ELSE
StatusStr:='** LOCK *';
Replace(StatusStr,'*',ch,0);
ActivityWindow^.ActivateWrite;
ActivityWindow^.ChangeHeader(1, StatusStr);
ActivityWindow^.DeActivateWrite;
END;
PROCEDURE MacroMenu(VAR Key: LongInt);
VAR
TempMacroName : S60;
LastCmd : Word;
FUNCTION GetFileName(VAR escaped : Boolean) : PathStr;
VAR
FileName : PathStr;
BEGIN
FileName := '';
Escaped:=NOT InputString(15,16,36,36,3,'Macro name','File name: ',FileName);
GetFileName := FileName;
END;
PROCEDURE EditMacro;
CONST
NullString : string[1] = '';
VAR
Modified : Boolean;
TempWin : WindowPtr;
MP : MacroRecPtr;
TempMacroKey, N : Word;
SaveWin : Pointer;
SP : StringPointer;
TempMacroName : S80;
BEGIN
MacrosOff;
MyWin(TempWin, 21,12,59,14,2,'Edit Macro',True);
Write(' Press the macrokey you want to edit');
TempMacroKey:=ReadKeyWord;
KillWindow(TempWin);
N:=FindMacroIndex(TempMacroKey);
IF N<>0 THEN
BEGIN
MP:=MacroPointers[N];
SP:=MacroNames[N];
if (SP=nil) then SP:=@NullString;
TempMacroName:=SP^;
SaveWindow(1,1,ScreenWidth,ScreenHeight,True,SaveWin);
WITH Cfg.Color[3] DO
MP:=EditKeys(TempMacroKey,MP^, 1, 2, ScreenWidth, ScreenHeight, TextColor, HighlightColor, Modified);
RestoreWindow(1, 1, ScreenWidth, ScreenHeight, True, SaveWin);
if (TempMacro.NumKeys=0) then
begin
DeallocateMacro(TempMacroKey);
AddLog(' ', 'Macro deleted');
end else
{allocate space for and define the macro if it was changed}
if Modified then
case AllocateMacro(TempMacroKey, MP^, TempMacroName) of
1..2 : {ErrorMessage(OutOfMemory)};
end;
END;
MacrosOn;
END;
PROCEDURE ListMacros;
VAR
Name : ^String;
i, key : Word;
s : String;
Special : Boolean;
ListWin : windowptr;
BEGIN
mywin(ListWin, 1, 2, 80, ScreenHeight, 3, 'Defined Macros',False);
Write(' Key Description');
GOTOXY(1, 2);
FOR i := 1 TO MaxMacros DO
BEGIN
key := DefinedKeys[i];
IF key<>EndOfMacro THEN
BEGIN
KeyToString(key, s, Special);
Name:=MacroNames[i];
WriteLn(' '+CPad(s,12), Name^);
END;
END;
REPEAT
GiveUpTime;
UNTIL GotESC;
KillWindow(ListWin);
END;
PROCEDURE RecordingOn;
VAR
TempWin: WindowPtr;
S : String;
Special : Boolean;
BEGIN
MacrosOff;
MacrosOn;
ScrapMacro.NumKeys := 0;
ScrapMacro.KeyArray[1] := EndOfMacro;
REPEAT
MyWin(TempWin, 21,12,59,14,2,'Record macro',True);
Write(' Press the key you want to redefine');
ScrapMacroKey := ReadKeyWord;
KillWindow(TempWin);
KeyToString(ScrapMacroKey, S, Special);
UNTIL (ScrapMacroKey=$011b) or (Confirm('Redefine '+S+' ?','N',11));
IF ScrapMacroKey<>$011b THEN
BEGIN
DeAllocateMacro(ScrapMacroKey);
MacroRecordingOn;
WriteMacroStatus;
END;
END;
PROCEDURE LoadMacros;
VAR
FileName : PathStr;
Merge : Boolean;
Err : Byte;
BEGIN
Merge:=(MacroCount>0) AND Confirm('Merge loaded macros with existing?','N',10);
FileName:=StartPath+'*.MAC';
IF NOT SelectFile(FileName) OR (FileName = '') THEN Exit;
Err:=ReadMacroFile(FileName, Merge);
CASE Err OF
0 : AddLog(' ','Macro file '''+FileName+''' loaded');
2 : AddLog(' ',FileName+' does not exist');
$fe: AddLog(' ','Load macro: Out of heap space');
$ff: Addlog(' ',FileName+' is not a valid macro file');
ELSE AddLog(' ','Load macro: I/O Error '+Long2Str(Err));
END;
END;
PROCEDURE SaveMacros;
VAR
FileName : PathStr;
escaped : Boolean;
Err : Byte;
BEGIN
FileName:=GetFileName(Escaped);
IF (Escaped) OR (FileName='') THEN Exit;
Err:=WriteMacroFile(FileName);
CASE Err OF
0 : AddLog(' ','Macro file '''+FileName+''' saved');
ELSE AddLog(' ','Save macro: I/O Error '+Long2Str(Err));
END;
END;
PROCEDURE DeleteOneMacro;
VAR
DelMacroKey : Word;
TempWin : WindowPtr;
s : String;
Special : Boolean;
BEGIN
MacrosOff;
REPEAT
MyWin(TempWin, 20,12,60,14,2,'Delete macro',True);
Write(' Press the macrokey you want to delete');
DelMacroKey := ReadKeyWord;
KillWindow(TempWin);
KeyToString(DelMacroKey, S, Special);
UNTIL (DelMacroKey=$011b) Or (Confirm('Delete '+S+' ?','N',11));
IF DelMacroKey<>$011b THEN
DeAllocateMacro(DelMacroKey);
MacrosOn;
MainMenu^.EraseCurrentSubMenu;
END;
PROCEDURE DeleteAllMacros;
VAR
i : Word;
BEGIN
FOR i := 1 TO MaxMacros DO
IF DefinedKeys[i]<>EndOfMacro THEN DeAllocateMacro(DefinedKeys[i]);
MainMenu^.EraseCurrentSubMenu;
END;
PROCEDURE EnableItems;
VAR
i : LongInt;
BEGIN
FOR i:=100 TO 108 DO
IF i<>107 THEN MainMenu^.UnProtectItem(i);
END;
PROCEDURE DisableItems;
VAR
i : LongInt;
BEGIN
FOR i:=100 TO 108 DO
IF i<>107 THEN MainMenu^.ProtectItem(i);
END;
BEGIN
IF MacroRecording THEN
BEGIN
MacroRecordingOff;
WITH ScrapMacro DO
KeyArray[NumKeys]:=EndOfMacro;
IF ScrapMacro.NumKeys=0 THEN
BEGIN
DeAllocateMacro(ScrapMacroKey);
AddLog(' ','Empty macro - not added');
END ELSE
BEGIN
TempMacroName := '';
IF InputString(2,11,60,60,2,'Save macro','Macro name: ',TempMacroName) THEN
BEGIN
IF TempMacroName='' THEN TempMacroName:='Unnamed';
CASE AllocateMacro(ScrapMacroKey, ScrapMacro, TempMacroName) OF
1 : AddLog(' ','Macro table full');
2 : AddLog(' ','Out of memory');
ELSE AddLog(' ','Macro added');
END;
END;
END;
IF Key<>0 THEN MainMenu^.Erase;
WriteMacroStatus;
Exit;
END;
LoadMainMenu;
IF Key=0 THEN
BEGIN
DisableItems;
MainMenu^.SelectSubMenu(90);
END;
InMainMenu:=True;
REPEAT
IF Key=0 THEN
BEGIN
MainMenu^.Process;
Key:=MainMenu^.MenuChoice;
LastCmd:=MainMenu^.GetLastCommand;
END ELSE
LastCmd:=ccSelect;
IF LastCmd<>ccQuit THEN
BEGIN
CASE key OF
90: BEGIN
RecordingOn;
IF MacroRecording THEN LastCmd:=ccQuit;
END;
91: EditMacro;
92: ListMacros;
93: BEGIN
MacrosAreOn:=NOT MacrosAreOn;
Data.MacroStatus:=MacrosAreOn;
END;
94: DeleteOneMacro;
95: IF Confirm('Delete ALL macros ?','N',12) THEN DeleteAllMacros;
96: LoadMacros;
97: SaveMacros;
END;
IF Key IN [90..97] THEN
BEGIN
MainMenuToggle;
Key:=0;
END;
END;
WriteMacroStatus;
UNTIL (LastCmd=ccQuit) OR (Key<>0);
InMainMenu:=False;
EnableItems;
IF (Key>40) OR (Key=0) THEN MainMenu^.EraseAllSubMenus(True, True);
MainMenu^.Erase;
END;
END.